home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / cplasma / vgagraph.pas < prev   
Pascal/Delphi Source File  |  1995-03-31  |  3KB  |  124 lines
  1. Unit VGAGraph;
  2.  
  3. Interface
  4.  
  5. Procedure InitGraph;
  6. Procedure CloseGraph;
  7. Procedure PutPixel( x, y : Integer; c : Byte );
  8. Procedure SetColor( c : Byte );
  9. Procedure Line( x1, y1, x2, y2 : Integer );
  10. Procedure SetRGBPalette( i, r, g, b : Byte );
  11. Procedure GetRGBPalette( i : byte;  var r, g, b : Byte );
  12.  
  13. Function GetPixel( x, y : Integer ) : Byte;
  14.  
  15. Implementation
  16.  
  17. var
  18.    FColor : Byte;
  19.  
  20. Function GetPixel( x, y : Integer ) : Byte;
  21. begin
  22.      GetPixel := Mem[$A000:(y*320)+x];
  23. end;
  24.  
  25. Procedure InitGraph;  Assembler;
  26. asm
  27.   mov ax, 0013h
  28.   int 10h
  29. end;
  30.  
  31. Procedure CloseGraph;  Assembler;
  32. asm
  33.   mov ax, 0003h
  34.   int 10h
  35. end;
  36.  
  37. Procedure PutPixel( x, y : Integer; c : Byte );
  38. begin
  39.   Mem[$A000:(y*320)+x] := c;
  40. end;
  41.  
  42. Procedure SetColor( c : Byte );
  43. begin
  44.      FColor := c;
  45. end;
  46.  
  47. Procedure Line( x1, y1, x2, y2 : Integer );
  48. var
  49.    Slope : Real;
  50.    RSlope : Real;
  51.    i : Integer;
  52.    DifX, DifY : Integer;
  53. begin
  54.      If (x1-x2)=0 then
  55.        begin
  56.             If y2 >= y1 then
  57.                For i := y1 to y2 do
  58.                  PutPixel( x1, i, FColor );
  59.             If y1 > y2 then
  60.                For i := y2 to y1 do
  61.                  PutPixel( x1, i, FColor );
  62.             Exit;
  63.        end;
  64.      If (y1-y2)=0 then
  65.        begin
  66.             If x1 < x2 then
  67.                For i := x1 to x2 do
  68.                    PutPixel( i, y1, FColor );
  69.             If x1 >= x2 then
  70.                For i := x2 to x1 do
  71.                    PutPixel( i, y1, FColor );
  72.             Exit;
  73.        end;
  74.  
  75.      Slope := (y1 - y2) / (x1 - x2);
  76.      DifX := Abs( x1 - x2 );
  77.      DifY := Abs( y1 - y2 );
  78. {     If x1 > x2 then
  79.         x1 := x2;
  80.      If y1 > y2 then
  81.         y1 := y2;}
  82.      If DifX <= DifY then
  83.        begin
  84.             If y1 > y2 then
  85.               begin
  86.                 x1 := x2;
  87.                 y1 := y2;
  88.               end;
  89.             RSlope := 1 / Slope;
  90.             For i := 0 to DifY do
  91.                 PutPixel( Trunc( i * RSlope ) + x1, i + y1, FColor );
  92.        end
  93.       else
  94.         begin
  95.           If x1 > x2 then
  96.             begin
  97.               x1 := x2;
  98.               y1 := y2;
  99.             end;
  100.             For i := 0 to DifX do
  101.                 PutPixel( i + x1, Trunc( Slope * i ) + y1, FColor );
  102.         end;
  103. end;
  104.  
  105. Procedure SetRGBPalette( i, r, g, b : Byte );
  106. begin
  107.   Port[$3C8] := i;
  108.   Port[$3C9] := r;
  109.   Port[$3C9] := g;
  110.   Port[$3C9] := b;
  111. end;
  112.  
  113. Procedure GetRGBPalette( i : byte;  var r, g, b : Byte );
  114. begin
  115.   Port[$3C8] := i;
  116.   r := Port[$3C9];
  117.   g := Port[$3C9];
  118.   b := Port[$3C9];
  119. end;
  120.  
  121. Begin
  122.   FColor := 15;
  123. End.
  124.